home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / product.arc / BASELINE.LSP < prev    next >
Encoding:
Text File  |  1986-11-06  |  3.0 KB  |  93 lines
  1. ;baseline dimensioning by Jim Brittian 
  2. ;see BASELINE.DOC for more information 
  3. ;Version 2.5 only
  4.  
  5. (Vmon) 
  6.  
  7. (Setq BASE (Getpoint "\nPick point to base dimensions from: ")) 
  8. (Setq TH (Getreal "Enter text height <RETURN IF FIXED>: ")) 
  9. (If (= TH nil) 
  10.     (Setq Z (* (Getvar "Textsize") 8)) 
  11.     (Setq Z (* TH 8)) 
  12. ) 
  13.  
  14. (Defun Basehorz () 
  15.        (Setq P2 (List (Car P2) (Cadr P1))) 
  16.        (Setq A (Rtos (Abs (- (Cadr P1) (Cadr BASE))) (Getvar
  17. "Lunits") 
  18.                                                    (Getvar
  19. "Luprec"))) 
  20.        (If (<= (Car P2) (Car P1)) 
  21.            (Progn 
  22.                 (Setq P1 (List (- (Car P1) (* 0.0625 Z)) (Cadr
  23. P1))) 
  24.                 (Setq P3 (List (- (Car P2) (* 0.0625 Z)) 
  25.                                (- (Cadr P2) (* 0.0625 Z)))) 
  26.                 (If (= TH nil) 
  27.                     (Command "Text" "R" P3 "0" A) 
  28.                     (Command "Text" "R" P3 (* 0.125 Z) "0" A) 
  29.                 ) 
  30.            ) 
  31.            (Progn 
  32.                 (Setq P1 (List (+ (Car P1) (* 0.0625 Z)) (Cadr
  33. P1))) 
  34.                 (Setq P3 (List (+ (Car P2) (* 0.0625 Z)) 
  35.                                (- (Cadr P2) (* 0.0625 Z)))) 
  36.                 (If (= TH nil) 
  37.                     (Command "Text" P3 "0" A) 
  38.                     (Command "Text" P3 (* 0.125 Z) "0" A) 
  39.                 ) 
  40.            ) 
  41.        ) 
  42.        (Command "Line" P1 P2 "") 
  43. ) 
  44.  
  45. (Defun Basevert () 
  46.        (Setq P2 (List (Car P1) (Cadr P2))) 
  47.        (Setq A (Rtos (Abs (- (Car P1) (Car BASE))) (Getvar
  48. "Lunits") 
  49.                                                  (Getvar
  50. "Luprec"))) 
  51.        (If (<= (Cadr P2) (Cadr P1)) 
  52.            (Progn 
  53.                 (Setq P1 (List (Car P1) (- (Cadr P1) (* 0.0625
  54. Z)))) 
  55.                 (Setq P3 (List (+ (Car P2) (* 0.0625 Z)) 
  56.                                (- (Cadr P2) (* 0.0625 Z)))) 
  57.                 (If (= TH nil) 
  58.                     (Command "Text" "R" P3 "90" A) 
  59.                     (Command "Text" "R" P3 (* 0.125 Z) "90" A) 
  60.                 ) 
  61.            ) 
  62.            (Progn 
  63.                 (Setq P1 (List (Car P1) (+ (Cadr P1) (* 0.0625
  64. Z)))) 
  65.                 (Setq P3 (List (+ (Car P2) (* 0.0625 Z)) 
  66.                                (+ (Cadr P2) (* 0.0625 Z)))) 
  67.                 (If (= TH nil) 
  68.                     (Command "Text" P3 "90" A) 
  69.                     (Command "Text" P3 (* 0.125 Z) "90" A) 
  70.                 ) 
  71.            ) 
  72.        ) 
  73.        (Command "Line" P1 P2 "") 
  74. ) 
  75.  
  76. (Defun C:Baseorg () 
  77.        (Setq BASE (Getpoint "\nPick point to base dimensions
  78. from: ")) 
  79. ) 
  80.  
  81. (Defun C:Baseline () 
  82.        (Setvar "Cmdecho" 0) 
  83.        (Command "Osnap" "End,Int,Cen") 
  84.        (Setq P1 (Getpoint "\nEnter first point: ")) 
  85.        (Command "Osnap" "Off") 
  86.        (Setq P2 (Getpoint "\nEnter second point: ")) 
  87.        (If (> (Abs (- (Car P1) (Car P2))) (Abs (- (Cadr P1) (Cadr
  88. P2)))) 
  89.            (Basehorz) 
  90.            (Basevert) 
  91.        ) 
  92. ) 
  93.